home *** CD-ROM | disk | FTP | other *** search
/ Over 1,000 Windows 95 Programs / Over 1000 Windows 95 Programs (Microforum) (Disc 1).iso / 0961 / mainform.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-04-14  |  9.5 KB  |  346 lines
  1. unit MainForm;
  2.  
  3. {
  4. WinTidy - program to clear out unwanted files
  5.  
  6. Revision history:
  7.  
  8. 1995 Apr 23  1.0.0  First version derived from DOS-based TIDY
  9.                     and WIN_TIDY programs.  Takes command line
  10.                     parameter for root directory.
  11. 1995 Apr 25  1.0.2  Use proper Screen.Cursor for hourglass
  12.                     Make caption reflect current scan location
  13. 1995 Nov 25  1.0.4  Add .RWS as unwanted file, Borland Resource Workshop binary
  14.                     Replace two list boxes by one with size integral
  15.                     Order files by size
  16.                     Add Select All button
  17. 1995 Dec 02  1.0.6  Add .WBK as unwanted file, WinWord 7 backup
  18. 1996 Jan 06  1.0.8  Only enable Delete button when relevant
  19.                     Make Find button have a Cancel function
  20.                     Use Delphi's own LowerCase function
  21. 1996 Mar 30  2.0.0  Delphi 2.0 32-bit version
  22.                     Allow limited form re-sizing
  23.                     Add .APS as unwanted file, Vis C++ binary saved resources
  24.                     Remove hour-glass cursor
  25.                     Add indication of bytes found for deleting
  26.                     Note that .MOZ and other cache files might be candidates
  27. 1996 Apr 16  2.0.2  Add severity button, find .FTS, .GID
  28.                     Add .DMP files to normal list
  29.                     Add status bar
  30. }
  31.  
  32. interface
  33.  
  34. uses
  35.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  36.   StdCtrls, FileCtrl, ExtCtrls, Buttons, ComCtrls;
  37.  
  38. type
  39.   Tfiles_to_find = (normal, extra);
  40.  
  41. type
  42.   TForm1 = class(TForm)
  43.     Panel1: TPanel;
  44.     Panel2: TPanel;
  45.     DirectoryListBox1: TDirectoryListBox;
  46.     DriveComboBox1: TDriveComboBox;
  47.     btnFind: TButton;
  48.     ListBox1: TListBox;
  49.     btnSelectAll: TButton;
  50.     btnDelete: TButton;
  51.     btnExit: TButton;
  52.     Label1: TLabel;
  53.     Label2: TLabel;
  54.     lblSize: TLabel;
  55.     grpSeverity: TRadioGroup;
  56.     btnNormal: TRadioButton;
  57.     btnExtra: TRadioButton;
  58.     StatusBar1: TStatusBar;
  59.     procedure btnExitClick(Sender: TObject);
  60.     procedure DirectoryListBox1Change(Sender: TObject);
  61.     procedure FormActivate(Sender: TObject);
  62.     procedure FormCreate(Sender: TObject);
  63.     procedure btnSelectAllClick(Sender: TObject);
  64.     procedure ListBox1Click(Sender: TObject);
  65.     procedure btnFindClick(Sender: TObject);
  66.     procedure Panel1Resize(Sender: TObject);
  67.     procedure Panel2Resize(Sender: TObject);
  68.     procedure btnDeleteClick(Sender: TObject);
  69.     procedure btnNormalClick(Sender: TObject);
  70.     procedure btnExtraClick(Sender: TObject);
  71.   private
  72.     { Private declarations }
  73.     scanning: boolean;
  74.     stop_requested: boolean;
  75.     files_to_find: Tfiles_to_find;
  76.     files_found: integer;
  77.     KB_found: integer;
  78.     suggested_min_x: integer;
  79.     suggested_min_y: integer;
  80.     procedure scan_tree (root: string);
  81.   protected
  82.     procedure GetMinMaxInfo (var info: TWMGetMinMaxInfo);  message WM_GETMINMAXINFO;
  83.   public
  84.     { Public declarations }
  85.   end;
  86.  
  87. var
  88.   Form1: TForm1;
  89.  
  90. implementation
  91.  
  92. {$R *.DFM}
  93. {$R version.res}   // 32-bit resource file
  94.  
  95. const
  96.   num_normal_names = 16;
  97.   normal_names: array [1..num_normal_names] of string =
  98.     ('*.tmp',
  99.      '~*.*',
  100.      '*.~*',
  101.      '*.?~?',
  102.      '*.aps',
  103.      '*.bak',
  104.      '*.bk?',
  105.      '*.bsc',
  106.      '*.dmp',
  107.      '*.dsm',
  108.      '*.ilk',
  109.      '*.pch',
  110.      '*.rws',
  111.      '*.sbr',
  112.      'backup*.wbk',
  113.      '*.$$$');
  114. const
  115.   num_extra_names = 2;
  116.   extra_names: array [1..num_extra_names] of string =
  117.     ('*.fts',
  118.      '*.gid');
  119.  
  120. procedure TForm1.FormCreate(Sender: TObject);
  121. var
  122.   params: string;
  123. begin
  124.   scanning := False;
  125.   btnDelete.Enabled := False;
  126.   btnSelectAll.Enabled := False;
  127.   stop_requested := False;
  128.   files_to_find := normal;
  129.   if ParamCount > 0 then
  130.     begin
  131.     params := ParamStr (1);
  132.     DriveComboBox1.Drive := params [1];
  133.     DirectoryListBox1.Directory := params;
  134.     end;
  135.   suggested_min_x := Width;
  136.   suggested_min_y := Height;
  137. end;
  138.  
  139. procedure TForm1.btnExitClick(Sender: TObject);
  140. begin
  141.   stop_requested := True;        // to stop the scanning loop
  142.   Close;
  143. end;
  144.  
  145. procedure TForm1.DirectoryListBox1Change(Sender: TObject);
  146. begin
  147.   Form1.Caption := 'WinTidy - ' + LowerCase (DirectoryListBox1.Directory);
  148. end;
  149.  
  150. procedure TForm1.FormActivate(Sender: TObject);
  151. begin
  152.   Form1.Caption := 'WinTidy - ' + DirectoryListBox1.Directory;
  153. end;
  154.  
  155. procedure TForm1.btnSelectAllClick(Sender: TObject);
  156. var
  157.   item: integer;
  158. begin
  159.   for item := 0 to ListBox1.Items.Count-1 do
  160.     ListBox1.Selected [item] := True;
  161.   btnDelete.Enabled := ListBox1.SelCount <> 0;
  162. end;
  163.  
  164. procedure TForm1.ListBox1Click(Sender: TObject);
  165. begin
  166.   btnDelete.Enabled := ListBox1.SelCount <> 0;
  167. end;
  168.  
  169. procedure TForm1.btnFindClick(Sender: TObject);
  170. begin
  171.   if scanning
  172.   then stop_requested := True
  173.   else
  174.     begin
  175.     btnFind.Caption := 'Stop';
  176.     btnDelete.Enabled := False;
  177.     btnSelectAll.Enabled := False;
  178.     lblSize.Caption := '';
  179.     Label1.Caption := '';
  180.     ListBox1.Clear;
  181.     scanning := True;
  182.     stop_requested := False;
  183.     DriveComboBox1.Enabled := False;
  184.     DirectoryListBox1.Enabled := False;
  185.     files_found := 0;
  186.     KB_found := 0;
  187.     try
  188.       scan_tree (DirectoryListBox1.Directory);
  189.     finally
  190.     end;
  191.     scanning := False;
  192.     DriveComboBox1.Enabled := True;
  193.     DirectoryListBox1.Enabled := True;
  194.     btnFind.Caption := 'Find';
  195.     btnSelectAll.Enabled := True;
  196.     if files_found <> 0
  197.     then
  198.       begin
  199.       Label1.Caption := 'Candidates for deleting ....';
  200.       StatusBar1.SimpleText := '';
  201.       btnSelectAll.Enabled := True;
  202.       end
  203.     else
  204.       begin
  205.       Label1.Caption := '';
  206.       StatusBar1.SimpleText := 'No files found';
  207.       btnSelectAll.Enabled := False;
  208.       end;
  209.     end;
  210. end;
  211.  
  212. procedure TForm1.scan_tree (root: string);
  213. var
  214.   test_name: string;
  215.   full_name: string;
  216.   s: TSearchRec;
  217.   wanted: integer;
  218.   num_to_check: integer;
  219.   KB: integer;
  220. begin
  221.   if stop_requested then Exit;
  222.   root := LowerCase (root);
  223.   StatusBar1.SimpleText := 'Searching ' + root + '...';
  224.   if root [Length (root)] <> '\' then root := root + '\';
  225.  
  226.   case files_to_find of
  227.     normal: num_to_check := num_normal_names;
  228.     extra: num_to_check := num_extra_names;
  229.   end;
  230.  
  231.   for wanted := 1 to num_to_check do
  232.     begin
  233.     Application.ProcessMessages;
  234.     case files_to_find of
  235.       normal: test_name := root + normal_names [wanted];
  236.       extra: test_name := root + extra_names [wanted];
  237.     end;
  238.     if FindFirst (test_name, faAnyFile, s) = 0 then
  239.     repeat
  240.       if stop_requested then Exit;
  241.       with s do
  242.         begin
  243.         Name := LowerCase (Name);
  244.         if (Attr <> faDirectory) then
  245.           begin
  246.           full_name := root + Name;
  247.           KB := (Size + 1023) div 1024;
  248.           Inc (files_found);
  249.           Inc (KB_found, KB);
  250.           lblSize.Caption := IntToStr (KB_found) + ' KB';
  251.           ListBox1.Items.Add (Format ('%5d  ', [KB]) + full_name);
  252.           end;
  253.         end;
  254.     until FindNext (s) <> 0;
  255.     FindClose (s);
  256.     end;
  257.  
  258.   test_name := root + '*.*';
  259.   if FindFirst (test_name, faAnyFile, s) = 0 then
  260.   repeat
  261.     with s do
  262.       if ((Attr and faDirectory) <> 0) and ((Name <> '.') and (Name <> '..'))
  263.         then scan_tree (root + Name);
  264.   until FindNext (s) <> 0;
  265.   FindClose (s);
  266. end;
  267.  
  268. procedure TForm1.Panel1Resize(Sender: TObject);
  269. begin
  270.   btnFind.Top := Panel1.Height - 16 - btnFind.Height;
  271.   btnDelete.Top := btnFind.Top;
  272.   btnSelectAll.Top := btnFind.Top;
  273.   btnExit.Top := btnFind.Top;
  274.   ListBox1.Height := btnFind.Top - 16 - ListBox1.Top;
  275.   grpSeverity.Top := Panel1.Height - 8 - grpSeverity.Height;
  276.   btnNormal.Top := grpSeverity.Top + 16;
  277.   btnExtra.Top := grpSeverity.Top + 32;
  278.   DriveComboBox1.Top := grpSeverity.Top - 16 - DriveComboBox1.Height;
  279.   DirectoryListBox1.Height := DriveComboBox1.Top - 16 - DirectoryListBox1.Top;
  280. end;
  281.  
  282. procedure TForm1.Panel2Resize(Sender: TObject);
  283. begin
  284.   btnExit.Left := Panel2.Width - 16 - btnExit.Width;
  285.   ListBox1.Width := Panel2.Width - 16 - ListBox1.Left;
  286. end;
  287.  
  288. procedure TForm1.GetMinMaxInfo (var info: TWMGetMinMaxInfo);
  289. begin
  290.   with info.MinMaxInfo.ptMinTrackSize do
  291.     begin
  292.     x := suggested_min_x;
  293.     y := suggested_min_y;
  294.     end;
  295. end;
  296.  
  297. procedure TForm1.btnDeleteClick(Sender: TObject);
  298. var
  299.   item: integer;
  300.   f: file;
  301.   filename: string;
  302. begin
  303.   for item := ListBox1.Items.Count-1 downto 0 do
  304.     begin
  305.     if ListBox1.Selected [item] then
  306.       begin
  307.       filename := Trim (ListBox1.Items.Strings [item]);
  308.       // remove the file size part of the string
  309.       while filename [1] <> ' ' do delete (filename, 1, 1);
  310.       filename := Trim (filename);
  311.       AssignFile (f, filename);
  312.       {$I-}  Erase (f);  {$I+}
  313.       if IOResult = 0
  314.         then ListBox1.Items.Delete (item)
  315.         else
  316.         begin
  317.         filename := 'Unable to delete the file: '#13#10#13#10 + filename +
  318.                     #13#10#13#10'Perhaps this file is still in use, ' +
  319.                     'or is write-protected ?' + #0;
  320.         MessageDlg (filename, mtWarning, [mbIgnore], 0);
  321.         end;
  322.       end;
  323.     end;
  324.  
  325.   if ListBox1.Items.Count = 0 then
  326.     begin
  327.     Label1.Caption := '';
  328.     btnDelete.Enabled := False;
  329.     btnSelectAll.Enabled := False;
  330.     end;
  331.  
  332.   lblSize.Caption := 'KBytes';
  333. end;
  334.  
  335. procedure TForm1.btnNormalClick(Sender: TObject);
  336. begin
  337.   files_to_find := normal;
  338. end;
  339.  
  340. procedure TForm1.btnExtraClick(Sender: TObject);
  341. begin
  342.   files_to_find := extra;
  343. end;
  344.  
  345. end.
  346.